home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbxymodd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-30  |  13.7 KB  |  416 lines
  1. (*===========================================================================*)
  2. (* X/Ymodem Protocol processor -- Download                                   *)
  3. (*                                                                           *)
  4. (*   Copyright 1989 by H. Roy Engehausen.  All rights reserved.              *)
  5. (*   This software may be freely distributed AND used, but it may not        *)
  6. (*   under any circumstances be sold by anyone other than the author.        *)
  7. (*   It may be distributed by a commercial company as long as it is          *)
  8. (*   FOR no cost.                                                            *)
  9. (*                                                                           *)
  10. (*===========================================================================*)
  11.  
  12. PROCEDURE xy_download(end_it : BOOLEAN);
  13.  
  14.   VAR
  15.  
  16.     b         : BOOLEAN;
  17.     err_count : BYTE;
  18.     i         : WORD;
  19.     s         : STRING[10];
  20.  
  21.   CONST
  22.     debug = FALSE;
  23.  
  24.   (*-------------------------------------------------------------------------*)
  25.   (* Subroutine to send an abort                                             *)
  26.   (*-------------------------------------------------------------------------*)
  27.  
  28.   PROCEDURE send_abort;
  29.  
  30.     VAR
  31.       i : BYTE;
  32.  
  33.     BEGIN;
  34.  
  35.       FOR i := 1 TO 10 DO
  36.         send_tnc_data_str(can);
  37.       send_drain;
  38.  
  39.       FOR i := 1 TO 50 DO
  40.         task_switch;
  41.  
  42.       do_mess_local(message_bin_abort_out);
  43.       abort_sw := TRUE;
  44.  
  45.     END;
  46.  
  47.   (*-------------------------------------------------------------------------*)
  48.   (* Subroutine to prep the buffer                                           *)
  49.   (*-------------------------------------------------------------------------*)
  50.  
  51.   PROCEDURE prep_buff;
  52.  
  53.     BEGIN;
  54.  
  55.       (*---------------------------------------------------------------------*)
  56.       (* Build the block number                                              *)
  57.       (*---------------------------------------------------------------------*)
  58.  
  59.       big_buff^.xy_b_no        := block_no;
  60.       big_buff^.xy_b_no_invert := NOT block_no;
  61.  
  62.       (*---------------------------------------------------------------------*)
  63.       (* Build the check characters                                          *)
  64.       (*---------------------------------------------------------------------*)
  65.  
  66.       IF crc_sw THEN
  67.         BEGIN;
  68.           build_crc;
  69.           tail_ptr^.xy_crc_hi := HI(check_num);
  70.           tail_ptr^.xy_crc_lo := LO(check_num);
  71.           INC(b_size);
  72.         END
  73.       ELSE
  74.         BEGIN;
  75.           build_sum;
  76.           tail_ptr^.xy_chksum := check_num;
  77.         END;
  78.  
  79.     END;
  80.  
  81.   (*-------------------------------------------------------------------------*)
  82.   (* Subroutine to send the buffer                                           *)
  83.   (*-------------------------------------------------------------------------*)
  84.  
  85.   PROCEDURE send_buff;
  86.  
  87.     VAR
  88.       err_count : BYTE;
  89.  
  90.     BEGIN;
  91.  
  92.       (*---------------------------------------------------------------------*)
  93.       (* Loop sending the same block until acked                             *)
  94.       (*---------------------------------------------------------------------*)
  95.  
  96.       err_count := 10;
  97.  
  98.       REPEAT
  99.  
  100.         (*-------------------------------------------------------------------*)
  101.         (* If too many errors then abort                                     *)
  102.         (*-------------------------------------------------------------------*)
  103.  
  104.         IF err_count = 0 THEN
  105.           BEGIN;
  106.             send_abort;
  107.             EXIT;
  108.           END;
  109.  
  110.         DEC(err_count);
  111.  
  112.         (*-------------------------------------------------------------------*)
  113.         (* Send the data                                                     *)
  114.         (*-------------------------------------------------------------------*)
  115.  
  116.         send_tnc_data_ub (big_buff, b_size);
  117.  
  118. IF debug THEN
  119. WRITELN('Block sent  ', b_size);
  120.  
  121.         (*-------------------------------------------------------------------*)
  122.         (* Get response                                                      *)
  123.         (*-------------------------------------------------------------------*)
  124.  
  125.         get_a_block;
  126.  
  127.         (*-------------------------------------------------------------------*)
  128.         (* Validate incoming data                                            *)
  129.         (*-------------------------------------------------------------------*)
  130.  
  131.         b := check_block(small_buff);
  132.  
  133. IF debug THEN
  134. WRITELN('GOT BLOCK = ', block_type, ' OK = ', b);
  135.  
  136.         (*-------------------------------------------------------------------*)
  137.         (* Handle cancel                                                     *)
  138.         (*-------------------------------------------------------------------*)
  139.  
  140.         IF block_type = can THEN
  141.           BEGIN;
  142.             do_mess_local(message_bin_abort_in);
  143.             abort_sw := TRUE;
  144.             EXIT;
  145.           END;
  146.  
  147.         (*-------------------------------------------------------------------*)
  148.         (* Loop until done                                                   *)
  149.         (*-------------------------------------------------------------------*)
  150.  
  151.       UNTIL b AND (block_type = ack);
  152.  
  153.     END; (*----- End sending of buffer --------------------------------------*)
  154.  
  155.   (*-------------------------------------------------------------------------*)
  156.   (* Ready a header block                                                    *)
  157.   (*-------------------------------------------------------------------------*)
  158.  
  159.   PROCEDURE prep_header;
  160.     BEGIN;
  161.  
  162.       (*---------------------------------------------------------------------*)
  163.       (* Header is block 0 and is 128 byte block                             *)
  164.       (*---------------------------------------------------------------------*)
  165.  
  166.       block_no := 0;
  167.  
  168.       b_size            := 1 + 1 + 1 + 128 + 1;
  169.  
  170.       FILLCHAR(big_buff^, b_size, 0);
  171.  
  172.       big_buff^.xy_type := soh;
  173.       tail_ptr          := @big_buff^.x_tail;
  174.  
  175.     END;
  176.  
  177.   (*-------------------------------------------------------------------------*)
  178.   (* Main line starts here                                                   *)
  179.   (*-------------------------------------------------------------------------*)
  180.  
  181.   BEGIN;
  182.  
  183.     (*-----------------------------------------------------------------------*)
  184.     (* Send the terminate block if wanted                                    *)
  185.     (*-----------------------------------------------------------------------*)
  186.  
  187.     IF end_it THEN
  188.       BEGIN;
  189.  
  190.         prep_header;
  191.         prep_buff;
  192.         send_buff;
  193.  
  194.         EXIT;
  195.  
  196.       END;
  197.  
  198.     (*-----------------------------------------------------------------------*)
  199.     (* Open the block for read                                               *)
  200.     (*-----------------------------------------------------------------------*)
  201.  
  202.     FILEMODE := 0;
  203.  
  204.     RESET(data_file^,1);
  205.     file_size := FILESIZE(data_file^);
  206.     CLOSE(data_file^);
  207.  
  208.     RESET(data_file^,128);
  209.  
  210.     FILEMODE := 2;
  211.  
  212.     free_semaphore(semaphore_interrupts);
  213.  
  214. IF debug THEN
  215. WRITELN('FILESIZE  = ', file_size);
  216.  
  217.     (*-----------------------------------------------------------------------*)
  218.     (* Wait proper response                                                 *)
  219.     (*-----------------------------------------------------------------------*)
  220.  
  221.     err_count := 11;
  222.  
  223.     REPEAT
  224.  
  225.       IF err_count = 0 THEN
  226.         BEGIN;
  227.           send_abort;
  228.           EXIT;
  229.         END;
  230.  
  231.       DEC(err_count);
  232.  
  233.       get_a_block;
  234.  
  235.       block_type := small_buff^.xy_type;
  236.  
  237. IF debug THEN
  238. WRITELN('GOT BLOCK = ', block_type);
  239.  
  240.       IF (to_sw AND (error_cnt = 0)) OR (block_type = can) THEN
  241.         BEGIN;
  242.           IF to_sw THEN
  243.             do_mess(message_bin_time_out)
  244.           ELSE
  245.             do_mess(message_bin_abort_in);
  246.           abort_sw := TRUE;
  247.           EXIT;
  248.         END;
  249.  
  250.     UNTIL (block_type = nak) OR (block_type = 'C');
  251.  
  252.     (*-----------------------------------------------------------------------*)
  253.     (* Set CRC switch appropriately                                          *)
  254.     (*-----------------------------------------------------------------------*)
  255.  
  256.     IF block_type = nak THEN
  257.       crc_sw := FALSE
  258.     ELSE
  259.       crc_sw := TRUE;
  260.  
  261. IF debug THEN
  262. WRITELN('CRC       = ', crc_sw);
  263.  
  264.     (*-----------------------------------------------------------------------*)
  265.     (* Send header                                                           *)
  266.     (*-----------------------------------------------------------------------*)
  267.  
  268.     IF ymodem_sw THEN
  269.       BEGIN;
  270.  
  271.         (*-------------------------------------------------------------------*)
  272.         (* Header is block 0 and is 128 byte block                           *)
  273.         (*-------------------------------------------------------------------*)
  274.  
  275.         block_no := 0;
  276.  
  277.         b_size            := 1 + 1 + 1 + 128 + 1;
  278.  
  279.         FILLCHAR(big_buff^, b_size, 0);
  280.  
  281.         big_buff^.xy_type := soh;
  282.         tail_ptr          := @big_buff^.x_tail;
  283.  
  284.         (*-------------------------------------------------------------------*)
  285.         (* Put out file name                                                 *)
  286.         (*-------------------------------------------------------------------*)
  287.  
  288.         FOR i := 1 TO LENGTH(search_arg) DO
  289.           IF search_arg[i] = '\' THEN
  290.             search_arg[i] := '/';
  291.  
  292.         MOVE(search_arg[1], big_buff^.x_b, LENGTH(search_arg));
  293.  
  294.         i := LENGTH(search_arg) + 2;
  295.  
  296.         (*-------------------------------------------------------------------*)
  297.         (* Put out file size                                                 *)
  298.         (*-------------------------------------------------------------------*)
  299.  
  300.         STR(file_size, s);
  301.  
  302.         MOVE(s[1], big_buff^.x_b[i], LENGTH(s));
  303.  
  304.         INC(i, LENGTH(s) + 2);
  305.  
  306.         (*-------------------------------------------------------------------*)
  307.         (* Put out the buffer                                                *)
  308.         (*-------------------------------------------------------------------*)
  309.  
  310.         prep_buff;
  311.  
  312.         send_buff;
  313.  
  314.         IF active_tcb^.error_sw OR abort_sw THEN
  315.           EXIT;
  316.  
  317.       END; (*----- End sending of header ------------------------------------*)
  318.  
  319.     (*-----------------------------------------------------------------------*)
  320.     (* Loop sending the data                                                 *)
  321.     (*-----------------------------------------------------------------------*)
  322.  
  323.     block_no  := 1;
  324.     curr_size := 0;
  325.  
  326.     REPEAT
  327.  
  328.       (*---------------------------------------------------------------------*)
  329.       (* Select things based on max block size                               *)
  330.       (*---------------------------------------------------------------------*)
  331.  
  332.       IF ymodem_sw AND ((file_size - curr_size) > 512) THEN
  333.         BEGIN;
  334.  
  335.           (*-----------------------------------------------------------------*)
  336.           (* 1024 byte block to be sent                                      *)
  337.           (*-----------------------------------------------------------------*)
  338.  
  339.           b_size            := 1 + 1 + 1 + 1024 + 1;
  340.           big_buff^.xy_type := stx;
  341.           tail_ptr          := @big_buff^.y_tail;
  342.  
  343.           FILLCHAR(big_buff^.y_b, 1024, eof);
  344.  
  345.           BLOCKREAD(data_file^, big_buff^.y_b, 8, i);
  346.  
  347.           INC(curr_size, 1024);
  348.  
  349.         END
  350.       ELSE
  351.         BEGIN;
  352.  
  353.           (*-----------------------------------------------------------------*)
  354.           (* 128 byte block to be sent                                       *)
  355.           (*-----------------------------------------------------------------*)
  356.  
  357.           b_size            := 1 + 1 + 1 + 128 + 1;
  358.           big_buff^.xy_type := soh;
  359.           tail_ptr          := @big_buff^.x_tail;
  360.  
  361.           FILLCHAR(big_buff^.x_b, 128, eof);
  362.  
  363.           BLOCKREAD(data_file^, big_buff^.x_b, 1, i);
  364.  
  365.           INC(curr_size, 128);
  366.  
  367.         END;
  368.  
  369. IF debug THEN
  370. WRITELN('SB        = ', b_size);
  371.  
  372.       (*---------------------------------------------------------------------*)
  373.       (* Send the buffer.  Exit if we fail                                   *)
  374.       (*---------------------------------------------------------------------*)
  375.  
  376.       prep_buff;
  377.       send_buff;
  378.  
  379.       IF active_tcb^.error_sw OR abort_sw THEN
  380.         EXIT;
  381.  
  382.       (*---------------------------------------------------------------------*)
  383.       (* Increment block number and wrap as needed                           *)
  384.       (*---------------------------------------------------------------------*)
  385.  
  386.       show_size;
  387.  
  388.       (*---------------------------------------------------------------------*)
  389.       (* Increment block number and wrap as needed                           *)
  390.       (*---------------------------------------------------------------------*)
  391.  
  392.       IF block_no = 255 THEN
  393.         block_no := 0
  394.       ELSE
  395.         INC(block_no);
  396.  
  397. IF debug THEN
  398. WRITELN('NEXT BLK  = ', block_no);
  399.  
  400.       (*---------------------------------------------------------------------*)
  401.       (* Loop until file all sent                                            *)
  402.       (*---------------------------------------------------------------------*)
  403.  
  404.     UNTIL curr_size >= file_size;
  405.  
  406.     (*-----------------------------------------------------------------------*)
  407.     (* File sent.. Send EOT                                                  *)
  408.     (*-----------------------------------------------------------------------*)
  409.  
  410.     b_size := 1;
  411.     big_buff^.xy_type := eot;
  412.  
  413.     send_buff;
  414.  
  415.   END;
  416.